home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBJ1_2.ZIP;1 / OBJECT1.PRG < prev    next >
Encoding:
Text File  |  1993-01-21  |  12.4 KB  |  549 lines
  1. //*****************************************************************************
  2. // OBJECT1.PRG
  3. // Standart object initializer for OBJECT v2.03
  4. // Copyright (c) 1991, JHK, JHK-Software, Piestany
  5. // Please compile with: /N/M/W/A
  6. //-----------------------------------------------------------------------------
  7.  
  8. #include "Set.ch"
  9. #include "Box.ch"
  10. #include "InKey.ch"
  11. #include "Object.ch"
  12. #include "SetCurs.ch"
  13.  
  14. static aDosScrn:={}    //static_array_Screen_data: DOS screen, used in ObjectInit()
  15. static aAboutScrn:={}  //static_array_Screen_data: before AboutOn() screen
  16. static lAbout:=false   //for AboutOff() in C_MENU.PRG
  17.  
  18. //*****************************************************************************
  19. // ObjectInit([cp],cProgName,nVersion,nYear,[cUser],[cAuthor],[cSpecLine]) --> true
  20. // define colors, init object system (define class), show entry screen
  21. // cp=nUserColorDefinition, may be 0,1,2 (black_white,monochrom,color)
  22. //
  23. function ObjectInit(cp,cProgName,nVersion,nYear,cUser,cAuthor,cSpecLine)
  24.   local cTime1,cTime2,dDate
  25.   //
  26.   set exact on
  27.   set confirm on
  28.   #ifndef ENGLISH
  29.     set date german
  30.   #endif
  31.   set deleted on
  32.   set softseek on
  33.   set epoch to 1970
  34.   set scoreboard off
  35.   set exclusive off
  36.   set wrap on
  37.   set bell on
  38.   //
  39.   public tColor:=0   //Typ color
  40.   set errors file to cErrFile
  41.   ParseInputPars(cp,cProgName,nVersion,nYear,cAuthor)
  42.   SetKey(K_F1,{||HelpKeys()})
  43.   SetKey(K_SH_F1,{||HelpField()})
  44.   SetKey(K_ALT_F10,{||Alert(ResTxt(078))})
  45.   public object Color of Color  //only one color definition for all program.
  46.   aDosScrn:=SaveScr()
  47.   SetColor(m->Color:Desk)
  48.   DrawBasicScreen(cProgName)
  49.   AboutOn(cProgName,nVersion,nYear,cUser,cAuthor,cSpecLine)
  50.   DOut("")
  51.   if SetDateTime()
  52.     dDate:=Date()
  53.     dDate:=EditItPrim(dDate,ResTxt(014),,MaxRow()-5)
  54.     if dDate<>Date()
  55.       GoodRun("date "+DtoC(dDate))
  56.     endif
  57.     cTime1:=cTime2:=Time()
  58.     cTime2:=EditItPrim(cTime1,ResTxt(015),,MaxRow()-5)
  59.     if !(cTime1==cTime2)
  60.       GoodRun("time "+cTime2)
  61.     endif
  62.   endif
  63.   return(true)
  64.  
  65.  
  66. //*****************************************************************************
  67. // ObjectDone() --> true
  68. // close databases, restore screen
  69. //
  70. function ObjectDone(lCanContinue)
  71.   default lCanContinue to true
  72.   if lCanContinue; LogOff(); endif
  73.   close all
  74.   RestScr(aDosScrn)
  75.   SetPos(Row()-1,0)         //don't allow free ms-dos line
  76.   if !lCanContinue;  quit; endif
  77.   return(true)
  78.  
  79.  
  80. //*****************************************************************************
  81. // ParseInputPars(cDOScommandLineParameter,cProgName,nVersion,nYear,cAuthor) --> true
  82. // work around DOS command line parameter
  83. //
  84. static function ParseInputPars(cp,cProgName,nVersion,nYear,cAuthor)
  85.   default cp to "/"+if(IsColor(),"3","0")
  86.   if "/RECOVER" $ Upper(cp)
  87.     net use (cIFR) new
  88.     LogSet(998)
  89.     net close
  90.     cp := "/"+if(IsColor(),"3","0")
  91.   endif
  92.   if !(SubStr(cp,2,1) $ "0123")
  93.     default cAuthor to ResTxt(001)
  94.     ?? cProgName+" v"+Transform(nVersion,"9.99")+"  (c)"+Transform(nYear,"9999")+", "+ResTxt(001)
  95.     ? ResTxt(008)+cProgName+" [/0|1|2|3|RECOVER] <Enter>"
  96.     ? ResTxt(009)
  97.     ? ResTxt(010)
  98.     ? ResTxt(011)
  99.     ? ResTxt(012)
  100.     ? ResTxt(013)
  101.     ?
  102.     quit    //do not insert LogOff(), because database are NOT OPENED!
  103.   endif
  104.   m->tColor:=Val(SubStr(cp,2,1))        //see ErrorSys.prg and C_Color.prg
  105.   return(true)
  106.  
  107.  
  108. //*****************************************************************************
  109. // SaveScr(R,C,R2,C2) --> ScreenArray
  110. // Save screen data into array
  111. //
  112. function SaveScr(R,C,R2,C2)
  113.   local sA:={}                //screen array
  114.   default R to 0
  115.   default C to 0
  116.   default R2 to MaxRow()
  117.   default C2 to MaxCol()
  118.   AAdd(sA,R)                      //1
  119.   AAdd(sA,C)                      //2
  120.   AAdd(sA,R2)                     //3
  121.   AAdd(sA,C2)                     //4
  122.   AAdd(sA,Row())                  //5
  123.   AAdd(sA,Col())                  //6
  124.   AAdd(sA,SetCursor())            //7
  125.   AAdd(sA,SetColor())             //8
  126.   AAdd(sA,SaveScreen(R,C,R2,C2))  //9
  127.   return(sA)
  128.  
  129.  
  130. //*****************************************************************************
  131. // RestScr(saScreen) --> true
  132. // Complete restore screen previously saved vith SaveScr()
  133. //
  134. function RestScr(sA)
  135.   SetPos(sA[5],sA[6])
  136.   SetCursor(sA[7])
  137.   SetColor(sA[8])
  138.   RestScreen(sA[1],sA[2],sA[3],sA[4],sA[9])
  139.   sA:=nil  //release memory
  140.   return(true)
  141.  
  142.  
  143.  
  144. //*****************************************************************************
  145. // DrawBasicScreen(PrgName) --> true
  146. //
  147. static function DrawBasicScreen(PrgName)
  148.   if !Empty(PrgName)
  149.     @ 0,0 say PadC( ResTxt(002)+PrgName+ResTxt(003), MaxCol()+1 ) color m->Color:Menu
  150.   else
  151.     @ 0,0,0,MaxCol() box " " color m->Color:Menu
  152.   endif
  153.   @ 1,0,        MaxRow()-1,MaxCol() box "∞∞∞∞∞∞∞∞∞" color m->Color:Desk
  154.   @ MaxRow(),0, MaxRow(),  MaxCol() box " " color m->Color:Menu
  155.   return(true)
  156.  
  157.  
  158. //*****************************************************************************
  159. // AboutOn(cProgName,nVersion,nYear,[cUser],[cAuthor]) --> true
  160. // thank my brother for writting this function.
  161. //
  162. function AboutOn(cProgName, nVersion, nYear, cEndUser, cAuthor, cSpecLine)
  163.   local cCharColor,cBoxColor,aChars
  164.   local i,j,cP1,cP2,cP3,cP4,cP5,cP6,cP7,cP8,cP9,cP10
  165.  
  166.   if lAbout; return( nil ); endif
  167.  
  168.   cCharColor:=ListAsArray(m->Color:Desk)[nEnhanced]
  169.   cBoxColor:=ListAsArray(m->Color:Menu)[nNormal]
  170.   aChars:={ ;
  171.   {" €€€€€±  ",;
  172.    "€€±  €€± ",;
  173.    "€€± €€€± ",;
  174.    "€€±€€€€± ",;
  175.    "€€€€±€€± ",;
  176.    "€€€± €€± ",;
  177.    " €€€€€±  "},;
  178.   ;
  179.   {"  €€±  ",;
  180.    "€€€€±  ",;
  181.    "  €€±  ",;
  182.    "  €€±  ",;
  183.    "  €€±  ",;
  184.    "  €€±  ",;
  185.    " €€€€± "},;
  186.   ;
  187.   {" €€€€€±  ",;
  188.    "€€±  €€± ",;
  189.    "     €€± ",;
  190.    "   €€±   ",;
  191.    " €€±     ",;
  192.    "€€±      ",;
  193.    "€€€€€€€± "},;
  194.   ;
  195.   {" €€€€€±  ",;
  196.    "€€±  €€± ",;
  197.    "     €€± ",;
  198.    "  €€€€±  ",;
  199.    "     €€± ",;
  200.    "€€±  €€± ",;
  201.    " €€€€€±  "},;
  202.   ;
  203.   {"    €€€±  ",;
  204.    "   €€€€±  ",;
  205.    "  €€±€€±  ",;
  206.    " €€± €€±  ",;
  207.    "€€€€€€€€± ",;
  208.    "     €€±  ",;
  209.    "    €€€€± "},;
  210.   ;
  211.   {"€€€€€€€± ",;
  212.    "€€±      ",;
  213.    "€€€€€€±  ",;
  214.    "     €€± ",;
  215.    "     €€± ",;
  216.    "€€±  €€± ",;
  217.    " €€€€€±  "},;
  218.   ;
  219.   {" €€€€€±  ",;
  220.    "€€±  €€± ",;
  221.    "€€±      ",;
  222.    "€€€€€€±  ",;
  223.    "€€±  €€± ",;
  224.    "€€±  €€± ",;
  225.    " €€€€€±  "},;
  226.   ;
  227.   {"€€€€€€€± ",;
  228.    "€€±  €€± ",;
  229.    "     €€± ",;
  230.    "    €€±  ",;
  231.    "   €€±   ",;
  232.    "  €€±    ",;
  233.    "  €€±    "},;
  234.   ;
  235.   {" €€€€€±  ",;
  236.    "€€±  €€± ",;
  237.    "€€±  €€± ",;
  238.    " €€€€€±  ",;
  239.    "€€±  €€± ",;
  240.    "€€±  €€± ",;
  241.    " €€€€€±  "},;
  242.   ;
  243.   {" €€€€€±  ",;
  244.    "€€±  €€± ",;
  245.    "€€±  €€± ",;
  246.    " €€€€€€± ",;
  247.    "     €€± ",;
  248.    "€€±  €€± ",;
  249.    " €€€€€±  "},;
  250.   ;
  251.   nil,nil,nil,nil,nil,nil,nil,;
  252.   ;
  253.   {" €€€€€±  ",;
  254.    "€€±  €€± ",;
  255.    "€€±  €€± ",;
  256.    "€€€€€€€± ",;
  257.    "€€±  €€± ",;
  258.    "€€±  €€± ",;
  259.    "€€±  €€± "},;
  260.   ;
  261.   {"€€€€€€€±  ",;
  262.    " €€±  €€± ",;
  263.    " €€±  €€± ",;
  264.    " €€€€€±   ",;
  265.    " €€±  €€± ",;
  266.    " €€±  €€± ",;
  267.    "€€€€€€€±  "},;
  268.   ;
  269.   {" €€€€€±  ",;
  270.    "€€±  €€± ",;
  271.    "€€±      ",;
  272.    "€€±      ",;
  273.    "€€±      ",;
  274.    "€€±  €€± ",;
  275.    " €€€€€±  "},;
  276.   ;
  277.   {"€€€€€€€±  ",;
  278.    " €€±  €€± ",;
  279.    " €€±  €€± ",;
  280.    " €€±  €€± ",;
  281.    " €€±  €€± ",;
  282.    " €€±  €€± ",;
  283.    "€€€€€€€±  "},;
  284.   ;
  285.   {"€€€€€€± ",;
  286.    "€€±     ",;
  287.    "€€±     ",;
  288.    "€€€€€±  ",;
  289.    "€€±     ",;
  290.    "€€±     ",;
  291.    "€€€€€€± "},;
  292.   ;
  293.   {"€€€€€€± ",;
  294.    "€€±     ",;
  295.    "€€±     ",;
  296.    "€€€€€±  ",;
  297.    "€€±     ",;
  298.    "€€±     ",;
  299.    "€€±     "},;
  300.   ;
  301.   {" €€€€€±  ",;
  302.    "€€±  €€± ",;
  303.    "€€±      ",;
  304.    "€€±      ",;
  305.    "€€± €€€± ",;
  306.    "€€±  €€± ",;
  307.    " €€€€€±  "},;
  308.   ;
  309.   {"€€±  €€± ",;
  310.    "€€±  €€± ",;
  311.    "€€±  €€± ",;
  312.    "€€€€€€€± ",;
  313.    "€€±  €€± ",;
  314.    "€€±  €€± ",;
  315.    "€€±  €€± "},;
  316.   ;
  317.   {" €€±  ",;
  318.    " €€±  ",;
  319.    " €€±  ",;
  320.    " €€±  ",;
  321.    " €€±  ",;
  322.    " €€±  ",;
  323.    " €€±  "},;
  324.   ;
  325.   {"     €€± ",;
  326.    "     €€± ",;
  327.    "     €€± ",;
  328.    "     €€± ",;
  329.    "     €€± ",;
  330.    "€€±  €€± ",;
  331.    " €€€€€±  "},;
  332.   ;
  333.   {"€€±  €€± ",;
  334.    "€€± €€±  ",;
  335.    "€€±€€±   ",;
  336.    "€€€€±    ",;
  337.    "€€±€€±   ",;
  338.    "€€± €€±  ",;
  339.    "€€±  €€± "},;
  340.   ;
  341.   {"€€±     ",;
  342.    "€€±     ",;
  343.    "€€±     ",;
  344.    "€€±     ",;
  345.    "€€±     ",;
  346.    "€€±     ",;
  347.    "€€€€€€± "},;
  348.   ;
  349.   {"€€±   €€± ",;
  350.    "€€€± €€€± ",;
  351.    "€€€€€€€€± ",;
  352.    "€€±€€±€€± ",;
  353.    "€€±   €€± ",;
  354.    "€€±   €€± ",;
  355.    "€€±   €€± "},;
  356.   ;
  357.   {"€€±   €€± ",;
  358.    "€€€±  €€± ",;
  359.    "€€€€± €€± ",;
  360.    "€€±€€±€€± ",;
  361.    "€€± €€€€± ",;
  362.    "€€±  €€€± ",;
  363.    "€€±   €€± "},;
  364.   ;
  365.   {" €€€€€±  ",;
  366.    "€€±  €€± ",;
  367.    "€€±  €€± ",;
  368.    "€€±  €€± ",;
  369.    "€€±  €€± ",;
  370.    "€€±  €€± ",;
  371.    " €€€€€±  "},;
  372.   ;
  373.   {"€€€€€€±  ",;
  374.    "€€±  €€± ",;
  375.    "€€±  €€± ",;
  376.    "€€€€€€±  ",;
  377.    "€€±      ",;
  378.    "€€±      ",;
  379.    "€€±      "},;
  380.   ;
  381.   {" €€€€€±    ",;
  382.    "€€±  €€±   ",;
  383.    "€€±  €€±   ",;
  384.    "€€±  €€±   ",;
  385.    "€€± €€€±   ",;
  386.    "€€±  €€€±  ",;
  387.    " €€€€€±€€± "},;
  388.   ;
  389.   {"€€€€€€±  ",;
  390.    "€€±  €€± ",;
  391.    "€€±  €€± ",;
  392.    "€€€€€€±  ",;
  393.    "€€±€€±   ",;
  394.    "€€± €€±  ",;
  395.    "€€±  €€± "},;
  396.   ;
  397.   {" €€€€€±  ",;
  398.    "€€±  €€± ",;
  399.    "€€±      ",;
  400.    " €€€€€±  ",;
  401.    "     €€± ",;
  402.    "€€±  €€± ",;
  403.    " €€€€€±  "},;
  404.   ;
  405.   {"€€€€€€€€± ",;
  406.    "   €€±    ",;
  407.    "   €€±    ",;
  408.    "   €€±    ",;
  409.    "   €€±    ",;
  410.    "   €€±    ",;
  411.    "   €€±    "},;
  412.   ;
  413.   {"€€±  €€± ",;
  414.    "€€±  €€± ",;
  415.    "€€±  €€± ",;
  416.    "€€±  €€± ",;
  417.    "€€±  €€± ",;
  418.    "€€±  €€± ",;
  419.    " €€€€€±  "},;
  420.   ;
  421.   {"€€±   €€± ",;
  422.    "€€±   €€± ",;
  423.    "€€±   €€± ",;
  424.    "€€±   €€± ",;
  425.    " €€± €€±  ",;
  426.    "  €€€€±   ",;
  427.    "   €€±    "},;
  428.   ;
  429.   {"€€±   €€± ",;
  430.    "€€±   €€± ",;
  431.    "€€±   €€± ",;
  432.    "€€±€€±€€± ",;
  433.    "€€€€€€€€± ",;
  434.    "€€€± €€€± ",;
  435.    "€€±   €€± "},;
  436.   ;
  437.   {"€€±   €€± ",;
  438.    " €€± €€±  ",;
  439.    "  €€€€±   ",;
  440.    "   €€±    ",;
  441.    "  €€€€±   ",;
  442.    " €€± €€±  ",;
  443.    "€€±   €€± "},;
  444.   ;
  445.   {"€€±   €€± ",;
  446.    "€€±   €€± ",;
  447.    " €€± €€±  ",;
  448.    "  €€€€±   ",;
  449.    "   €€±    ",;
  450.    "   €€±    ",;
  451.    "   €€±    "},;
  452.   ;
  453.   {"€€€€€€€€± ",;
  454.    "     €€±  ",;
  455.    "    €€±   ",;
  456.    "   €€±    ",;
  457.    "  €€±     ",;
  458.    " €€±      ",;
  459.    "€€€€€€€€± "},;
  460.   ;
  461.   {"      ",;
  462.    "      ",;
  463.    "      ",;
  464.    "      ",;
  465.    "      ",;
  466.    "      ",;
  467.    "      "},;
  468.   ;
  469.   {"       ",;
  470.    "       ",;
  471.    "       ",;
  472.    "       ",;
  473.    "       ",;
  474.    "       ",;
  475.    "€€€€€± "} }
  476.  
  477.   aAboutScrn:=SaveScr(1,0,MaxRow()-1)
  478.   SetCursor(SC_NONE)
  479.  
  480.   default cAuthor  to ResTxt(001)
  481.   default cEndUser to ""
  482.  
  483.   if Len(cProgName)>8; Abort("ProgName too long."); endif
  484.   cProgName := StrTran( Upper(cProgName), " ", "[")
  485.   cProgName := StrTran( Upper(cProgName), "_", "\")
  486.  
  487.   cP1:=cP2:=cP3:=cP4:=cP5:=cP6:=cP7:=cP8:=cP9:=cP10:=""
  488.  
  489.   for i:=1 to Len(cProgName)
  490.     j := Asc( SubStr( cProgName, i, 1 ) ) - Asc("0") + 1
  491.     cP1 += aChars[j,1]
  492.     cP2 += aChars[j,2]
  493.     cP3 += aChars[j,3]
  494.     cP4 += aChars[j,4]
  495.     cP5 += aChars[j,5]
  496.     cP6 += aChars[j,6]
  497.     cP7 += aChars[j,7]
  498.   endfor
  499.  
  500.   i:=Len(cP1)-1
  501.   cP1 :=Left(cP1,i)
  502.   cP2 :=Left(cP2,i)
  503.   cP3 :=Left(cP3,i)
  504.   cP4 :=Left(cP4,i)
  505.   cP5 :=Left(cP5,i)
  506.   cP6 :=Left(cP6,i)
  507.   cP7 :=Left(cP7,i)
  508.   cP8 :=ResTxt(004)+Transform(nVersion,"9.99")
  509.   cP9 :=iif(cEndUser=="","",ResTxt(005)+cEndUser)
  510.   cP10:="Copyright (c) "+LTrim(Str(nYear))+", "+cAuthor
  511.  
  512.   @ 3,2,19,77 box B_DOUBLE_SINGLE+" " color cBoxColor
  513.  
  514.   @ 3+2,3 say Padc(cP1,74) color cCharColor
  515.   @ 3+3,3 say Padc(cP2,74) color cCharColor
  516.   @ 3+4,3 say Padc(cP3,74) color cCharColor
  517.   @ 3+5,3 say Padc(cP4,74) color cCharColor
  518.   @ 3+6,3 say Padc(cP5,74) color cCharColor
  519.   @ 3+7,3 say Padc(cP6,74) color cCharColor
  520.   @ 3+8,3 say Padc(cP7,74) color cCharColor
  521.   if cSpecLine<>nil
  522.     @ 3+10,3 say Padc(cP8,74) color cBoxColor
  523.     @ 3+11,3 say Padc(cSpecLine,74) color cBoxColor
  524.   else
  525.     @ 3+11,3 say Padc(cP8,74) color cBoxColor
  526.   endif
  527.   @ 3+12,3 say Padc(cP9,74) color cBoxColor
  528.   @ 3+13,3 say Padc(cP10,74) color cBoxColor
  529.   @ 3+14,3 say Padc(ResTxt(006),74) color cBoxColor
  530.   lAbout:=true
  531.   return(true)  //AboutOn()
  532.  
  533.  
  534. //*****************************************************************************
  535. // AboutOff(lKeepCursor) --> true/false
  536. // Restore screen previously modified vith AboutOn(...)
  537. //
  538. function AboutOff(lKeepCursor)
  539.   local R:=Row(),C:=Col()
  540.   if lAbout
  541.     lAbout:=false
  542.     RestScr(aAboutScrn)
  543.     if lKeepCursor; SetPos(R,C); endif
  544.     return(true)
  545.   endif
  546.   return(false)
  547.  
  548. //-------------------------------------------------- eof (c)JHK ---------------
  549.